home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Your Choice 1
/
your choice.zip
/
your choice
/
PRGMMING
/
VISIONIX
/
VCOPYU.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-12-30
|
85KB
|
3,135 lines
{
════════════════════════════════════════════════════════════════════════════
Visionix File Copy Unit (VCOPY)
Version 0.17
Copyright 1991,92,93 Visionix
ALL RIGHTS RESERVED
────────────────────────────────────────────────────────────────────────────
Revision history in reverse chronological order:
Initials Date Comment
──────── ──────── ────────────────────────────────────────────────────────
jrt 12/23/93 Cleaned up and added documentation
jrt 10/27/93 Renamed from VCOPY to VCOPYu for BETA 0.30
jrt 10/13/93 Put a call to VMultiDo in various parts of the
code.
jrt 05/15/93 Merged with beta 0.20b code.
mep 04/30/93 Finished callback procedures and documentation.
Optimized some code.
mep 03/26/93 Fixed bug with "Append" command. Also added use of
VType.maxArrSize variable.
mep 03/23/93 Updated show parameter and added to "CallBack" stuff.
mep 03/12/93 Added External "CallBack" Procedure for user interface.
mep 02/12/93 Fixed bug with ListFile (EOF).
mep 02/11/93 Cleaned up code for beta release
jrt 02/08/93 Sync with beta 0.12 release
mep 01/24/93 Few minor bug fixes.
mep 12/22/92 General cleanup of code.
mep 12/18/92 Deleted: SHOWFILES, SHOWATTR.
Added: SHOW=FADTPS
mep 12/16/92 Now allowed to place wildcards, target paths, and
additional parameters per line in a list file
(see below for usage).
Ranged dates are now allowed by using multiple
DATE/TIME parameter fields.
Added new parameters: DATEOA, DATEOB, TIMEOA, and TIMEOB.
mep 12/09/92 New functionality throughout unit.
Fixed VCopySetFlag and VCopyClearFlag to work with
the LongInt flag. Also fixed some bugs.
Added new parameters: TESTMODE, TARGETDIRONLY,
and SHOWATTR.
Added @ListFile for selected file copies.
Changed MAKEDIR command to MAKETARGETDIR.
mep 12/06/92 Moved some functions to VGen
jrt 11/21/92 Sync with beta 0.08
mep 11/19/92 Added most of the planned functionality.
mep 11/04/92 First logged revision.
────────────────────────────────────────────────────────────────────────────
}
(*-
[TEXT]
<Overview>
VCOPYu contains two functions, VCopyFile and VCopyFileEx.
The VCopyFile function allows you
to copy files from one place to another. It supports wildcards,
copy from/to date ranges; copy files with specified attributes,
the ability to copy sub-directories, and more.
The VCopyFileEx function does everything that VCopyFile does,
with the added capability to have VCopyFileEx call a "call-back"
procedure that you can specify when different VCopyFile events
occur. (Such as: starting a new file, read error, write error, etc)
<Interface>
-*)
Unit VCopyu;
INTERFACE
Uses
DOS,
VTypesu,
VStringu,
VGenu,
VMultiu,
VDOSHu,
VDatesu;
Const
{-------------------}
{ VCopy Error Codes }
{-------------------}
erVCopy_None = 0; { No error occurred }
erVCopy_SamePath = 1; { Source and target paths are the same }
erVCopy_NoExistFileFrom = 2; { Source file path does not exist }
erVCopy_NoExistFileTo = 3; { Target file path does not exist }
erVCopy_NoExistDirFrom = 4; { Source directory path does not exist }
erVCopy_NoExistDirTo = 5; { Target directory path does not exist }
erVCopy_NoRoom = 6; { No room left in target path }
erVCopy_Timeout = 7; { Timeout has been exceeded }
erVCopy_ListFileNotFound = 9; { List file was not found }
erVCopy_TargetPathIsFile = 10; { Target path is actually a file }
erVCopy_Fail = 11; { Failed copying of file(s) }
{------------------------}
{ Global Callback Events }
{------------------------}
cbeSourceOpen = $00000001; { Opening the source file }
cbeTargetOpen = $00000002; { Opening the target file }
cbeReadBlock = $00000004; { Reading a block from the source file }
cbeWriteBlock = $00000008; { Writing a block to the target file }
cbeSourceClose = $00000010; { Closing the source file }
cbeTargetClose = $00000020; { Closing the target file }
cbeIOErr = $00000040; { Some I/O error has occured }
cbeVCopyErr = $00000080; { Some VCopy error has occured }
cbeAll = $0000FFFF; { Report all global events }
{---------------------------}
{ Selective Callback Events }
{---------------------------}
cbeExternReadBlock = $00010000; { Calling an external procedure to read }
{ a block. Buffer and amount given. }
cbeExternWriteBlock = $00020000; { Calling an external procedure to write }
{ a block. Buffer and amount given. }
cbsRead = $00000001;
cbsWrite = $00000002;
ccOK = 0;
ccAbort = 1000;
ccRetry = 2000;
ccFail = 3000;
{---------------------------------------}
{ Date and Time output for Show command }
{ following VDates rules. }
{---------------------------------------}
vcDateStr : STRING = '$M+ $D+, Y+';
vcTimeStr : STRING = 'HH:II';
vcPackDateStr : STRING = 'MM-DD-YY';
Type
TCopyCallBackInfo = RECORD
Event : LONGINT;
StrParam : STRING;
NumParam1 : LONGINT;
NumParam2 : LONGINT;
PtrParam1 : POINTER;
RetCode : LONGINT
END;
PCopyCallBackInfo = ^TCopyCallBackInfo;
TCopyCallBackProc = Procedure( CBI : PCopyCallBackInfo );
PCopyCallBackProc = ^TCopyCallBackProc;
{────────────────────────────────────────────────────────────────────────────}
Function VCopyFile( stPathFrom : PathStr;
stPathTo : PathStr;
Params : STRING ) : INTEGER;
(*-
[FUNCTION]
Function VCopyFile( stPathFrom : PathStr;
stPathTo : PathStr;
Params : STRING ) : INTEGER;
[PARAMETERS]
stPathFrom ... [d:][path]filespec(s) for source of copy. Wildcards allowed.
or
... @[d:][path]listfile - get filespec(s) from this text file.
(see notes below).
stPathTo ... [d:][path]filespec(s) for target. Wildcard-mask allowed.
Params ... the 23 defined parameters:
MOVE Move instead of copy.
NOOVERWRITE Do not overwrite duplicate target file.
SUBDIR Copy source directory and all subdirectories.
SHOW=FADTPS Show each file's general info:
Filename, Attributes, Date, Time, Packed-date, or Size.
ATTR=ASHR Search mask for source attributes types:
Archive, System, Hidden, and Readonly
EXACTATTR Each found source file needs to be exactly the above
attribute mask in order to be copied.
NEWER Copy only if target doesn't exist or source is newer.
SHARE Use file-sharing/locking for copy.
TIMEOUT=SSS Timeout for events (like SHARE).
APPEND Append source file(s) to single target file.
DATE=MM-DD-YY Copy file(s) ON this date.
DATEB=MM-DD-YY Copy file(s) BEFORE this date.
DATEA=MM-DD-YY Copy file(s) AFTER this date.
DATEOB=MM-DD-YY Copy file(s) ON or BEFORE this date.
DATEOA=MM-DD-YY Copy file(s) ON or AFTER this date.
TIME=HH:MM Copy file(s) AT this time.
TIMEB=HH:MM Copy file(s) BEFORE this time.
TIMEA=HH:MM Copy file(s) AFTER this time.
TIMEOB=HH:MM Copy file(s) ON or BEFORE this time.
TIMEOA=HH:MM Copy file(s) ON or AFTER this time.
MAKETARGETDIR Create the target directory if it does not exist.
Otherwise, stPathTo will be thought as the target
filename (wildcard) mask.
TARGETDIRONLY Do not create target subdirectories to match source
subdirectories; instead, copy all source filespecs
only to the main target directory.
TESTMODE Do everything as usual except the actual copying.
[RETURNS]
VCopyFile returns a VCopy Error.
{-------------------}
{ VCopy Error Codes }
{-------------------}
erVCopy_None = 0; { No error occurred }
erVCopy_SamePath = 1; { Source and target paths are the same }
erVCopy_NoExistFileFrom = 2; { Source file path does not exist }
erVCopy_NoExistFileTo = 3; { Target file path does not exist }
erVCopy_NoExistDirFrom = 4; { Source directory path does not exist }
erVCopy_NoExistDirTo = 5; { Target directory path does not exist }
erVCopy_NoRoom = 6; { No room left in target path }
erVCopy_Timeout = 7; { Timeout has been exceeded }
erVCopy_ListFileNotFound = 9; { List file was not found }
erVCopy_TargetPathIsFile = 10; { Target path is actually a file }
erVCopy_Fail = 11; { Failed copying of file(s) }
[DESCRIPTION]
■ There are no set order for parameters to be passed in - only that
there be no spaces in the string and that commas are used between
all parameters.
■ Share parameter is for network environments, where a source/target file
might be opened by someone else. In order to insure system integrity,
VCopy will keep polling on the file until it becomes available or a
timeout occurs.
■ Timeout for events defaults to 30 seconds.
■ VCopy is fully compliant with VMulti. (It calls VMultiDO to keep
multi-procedures running)
■ When using a listfile, it is a valid ASCII file containing line-by-line
valid filenames (including exact path if not in default directory)
with three parameters per line (the second two are optional) -
(1) Source filespec, (2) target filespec, and (3) additional parameters.
Spacing between these three parameters is not significant.
Usage: SourcePath [TargetPath] [/AdditionalParams]
Although the TargetPath is optional (defaults to stPathTo if
not present), the SourcePath must be present for a copy to occur.
If additional parameters are needed for a specific line, just
add them the same way the parameters are originally passed in,
except remember to add a "/" BEFORE the additional parameter list.
■ In TestMode, the SubDir (actual directory creation/removal), NoOverwrite
and Newer flags do not function.
[SEE-ALSO]
VCopyFileEx
[EXAMPLE]
#1 Copy COMMAND.COM to drive E root directory.
VCopyFile('C:\COMMAND.COM','E:\','');
#2 Move all of drive D to drive E's TEST directory and show files.
It will create directory TEST if not there. In addition, this
will create all of the target directories under the main source
directory and place the target files accordingly.
VCopyFile('D:\', 'E:\TEST', 'MOVE,SUBDIR,MAKETARGETDIR,SHOW=F');
#3 Copy all files with ONLY the Hidden and System attributes set
from drive C to drive A.
VCopyFile('C:\', 'A:\', 'SUBDIR,SHOW=F,ATTR=HS,EXACTATTR');
#4 Copy all files in subdirectory DOS that match the wildcard pattern
to subdirectory B (create if not exist) with a different mask.
VCopyFile('\DOS\*.COM', '\B\*.BIN', 'SHOW=F,MAKETARGETDIR');
#5 Copy all files from subdirectory TEST1 to subdirectory TEST2
in week of 01-03-93 to 01-09-93. Note that these directories
are considered in the "current/default" directory; if not, make
sure the full path for each is supplied.
VCopyFile('TEST1', 'TEST2', 'DATEOA=01-03-93,DATEOB=01-09-93');
#6 Copy all of drive D to drive E's TEST directory and show files.
(see example #2). The difference is that the target directories
will not be created; rather, all of the matching source files
will only go into the TEST directory.
VCopyFile('D:\', 'E:\TEST', 'SUBDIR,MAKETARGETDIR,TARGETDIRONLY,SHOW=F');
#7 Copy all the files inside listfile C:\DIR.LST into subdirectory
D:\TEST with default parameters - each line will add to this set.
VCopyFile('@C:\FILE.LST', 'D:\TEST', 'SHOW=F,TARGETDIRONLY' );
The listfile 'C:\FILE.LST' looks like this:
---
C:\WINDOWS\HIMEM.SYS
F:\WP51\*.* C:\WP51 /MAKETARGETDIR,SUBDIR,SHOW=A
C:\DOS\C*.* D:\SHIP\*.BAT
---
The first pathspec "C:\WINDOWS\HIMEM.SYS" will be copied to
directory D:\TEST.
The second pathspec "F:\WP51\*.*" will copy all files in and under
that subdirectory to drive C subdirectory WP51 (and create it if
it doesn't exist), while showing each file's attribute set.
The third pathspec "C:\DOS\C*.*" will copy all files that match
the wildcards to D:\SHIP while renaming all files to *.BAT. Note
that the additional parameters toggled on the second line did not
occur on this line.
══════════════════════════════════════════════════════════════════════════
-*)
Function VCopyFileEx( stPathFrom : PathStr;
stPathTo : PathStr;
Params : STRING;
CBEvents : LONGINT;
CBProc : PCopyCallBackProc ) : INTEGER;
(*-
[FUNCTION]
Function VCopyFileEx( stPathFrom : PathStr;
stPathTo : PathStr;
Params : STRING;
CBEvents : LONGINT;
CBProc : PCopyCallBackProc ) : INTEGER;
[PARAMETERS]
VCopyFileEx returns a VCopy Error (see above constants).
stPathFrom, stPathTo, and Params are same as VCopyFile (see above).
CBProc ... A pointer to a user-defined procedure.
CBEvents ... Selected callback events:
Global Events
-------------
cbeSourceOpen = Opening the source file.
cbeTargetOpen = Opening the target file.
cbeReadBlock = Reading a block from the source file.
cbeWriteBlock = Writing a block to the target file.
cbeSourceClose = Closing the source file.
cbeTargetClose = Closing the target file.
cbeIOErr = Some I/O error has occured.
cbeVCopyErr = Some VCopy error has occured.
cbeAll = All of the above.
Selective Events
----------------
cbeExternReadBlock = Calling an external procedure to read a block.
cbeExternWriteBlock = Calling an external procedure to write a block.
[RETURNS]
VCopyFile returns a VCopy Error.
{-------------------}
{ VCopy Error Codes }
{-------------------}
erVCopy_None = 0; { No error occurred }
erVCopy_SamePath = 1; { Source and target paths are the same }
erVCopy_NoExistFileFrom = 2; { Source file path does not exist }
erVCopy_NoExistFileTo = 3; { Target file path does not exist }
erVCopy_NoExistDirFrom = 4; { Source directory path does not exist }
erVCopy_NoExistDirTo = 5; { Target directory path does not exist }
erVCopy_NoRoom = 6; { No room left in target path }
erVCopy_Timeout = 7; { Timeout has been exceeded }
erVCopy_ListFileNotFound = 9; { List file was not found }
erVCopy_TargetPathIsFile = 10; { Target path is actually a file }
erVCopy_Fail = 11; { Failed copying of file(s) }
[DESCRIPTION]
NOTES:
■ The main use of the callback procedure is for a program to keep an
update status of what has been occuring during the copying process
(ie. updating "Copy Percentage Complete" view-bars).
■ Note that the callback procedure is always called BEFORE the actual
event is going to occur (useful for traps).
■ CBEvents are the conditions when the callback procedure will be called.
When the cbeAll event is issued, all Global Events will be reported
to the callback procedure - no Selective Events are included with the
cbeAll.
■ CBProc is a far-called procedure of type TCopyCallBackProc defined as:
Procedure(CBI : PCopyCallBackInfo). Make sure you type cast your
user-defined callback procedure to work as such. VCopy will be the
only one calling this procedure. Also, the event packets are defined
below for each event.
■ External reading/writing routines during a file copy are allowed by
supplying the cbeExtern events within the CBEvents, and including the
appropriate routines within your callback procedure. This is useful
if VCopy's internal methods do not work properly (some proprietary
devices do not work with standard BlockRead/BlockWrite commands).
VCopy will give you buffers to use, so unless you need you own for
some reason, use the buffers at the defined PtrParam (PtrParam points
to the first byte in the buffer). Also, a request will be sent to
your external read/write routines with the number of bytes to
read/write. This might vary with the actual amount, which always
needs to get returned from your procedure.
CALLBACK EVENT PACKETS:
Global Events
-------------
cbeSourceOpen
-------------
ENTRY :
StrParam := Source file
EXIT : none
cbeTargetOpen
-------------
ENTRY :
StrParam := Target file
NumParam1 := File mode:
0 = Rewrite
100 = Append
EXIT : none
cbeReadBlock
------------
ENTRY :
StrParam := Source file
NumParam1 := Number of bytes wanting to read
PtrParam := VCopy's internal buffer. The length here equals the
NumParam1 entry parameter
RetCode := 0
EXIT :
RetCode := Result of read operation report:
0 = OK/Continue
1000 = Abort current copy
3000 = Fail all copies
cbeWriteBlock
-------------
ENTRY :
StrParam := Target file
NumParam1 := Number of bytes wanting to write (actual read bytes)
0 = if end of source (copy complete)
PtrParam := VCopy's internal buffer. The length here equals
the NumParam1 Entry parameter in the previously called
cbeExternReadBlock or cbeReadBlock event (they are
treated here the same)
RetCode := 0
EXIT :
RetCode := Result of write operation report:
0 = OK/Continue
1000 = Abort current copy
3000 = Fail all copies
cbeSourceClose
--------------
ENTRY :
StrParam := Source file
EXIT : none
cbeTargetClose
--------------
ENTRY :
StrParam := Target file
EXIT : none
cbeIOErr
--------
ENTRY :
NumParam1 := IO error of last operation
EXIT :
RetCode := Result of user-defined IO error report operation:
0 = OK/Fixed
1000 = Abort
2000 = Retry last operation
3000 = Fail all copies
cbeVCopyErr
-----------
ENTRY :
NumParam1 := VCopy errorcode
EXIT : none
Selective Events
----------------
cbeExternReadBlock
------------------
ENTRY :
StrParam := Source file
NumParam1 := Number of bytes wanting to read
PtrParam := VCopy's internal buffer. The length here equals the
NumParam1 entry parameter
RetCode := 0
EXIT :
NumParam1 := Number of bytes actually read
0 = End of copy
PtrParam := Filled buffer
RetCode := Result of user-defined read operation:
0 = OK/Continue
1000 = Abort current copy
3000 = Fail all copies
cbeExternWriteBlock
-------------------
ENTRY :
StrParam := Target file
NumParam1 := Number of bytes wanting to write (actual read bytes)
0 = if end of source (copy complete)
PtrParam := VCopy's internal buffer. The length here equals
the NumParam1 Entry parameter in the previously called
cbeExternReadBlock or cbeReadBlock event (they are
treated here the same)
RetCode := 0
EXIT :
NumParam1 := Number of bytes actually wrote
RetCode := Result of user-defined write operation:
0 = OK/Continue
1000 = Abort current copy
3000 = Fail all copies
[EXAMPLE]
#1 Copy COMMAND.COM to drive D root directory allowing reports of all
global events into MyCopyProc.
VCopyFileEx('C:\COMMAND.COM','D:\','',cbeAll,@MyCopyProc);
..where an example MyCopyProc could be..
Procedure MyCopyProc( CBI : PCopyCallBackInfo ); Far;
Var Ch : Char;
BEGIN
With TCopyCallBackInfo( CBI^ ) Do
BEGIN
Case Event of
cbeSourceOpen : WriteLn('Opening source file ', StrParam);
cbeTargetOpen :
case NumParam1 of
0 : WriteLn('Opening target file ', StrParam);
100 : WriteLn('Appending target file ', StrParam);
end;
cbeReadBlock : WriteLn('Reading ', NumParam1, ' bytes.');
cbeWriteBlock :
If (NumParam1 = 0) Then
WriteLn('Copy complete.')
Else
WriteLn('Writing ', NumParam1, ' bytes.');
cbeSourceClose: WriteLn('Closing source file ', StrParam);
cbeTargetClose: WriteLn('Closing target file ', StrParam);
cbeIOErr :
BEGIN
WriteLn('IO Error ', NumParam1, '. Abort, Retry, Fail?');
Ch := Readkey;
Case UpCase(Ch) of
'A' : RetCode := 1000;
'R' : RetCode := 2000;
'F' : RetCode := 3000;
End;
END;
End;
END;
END;
#2 Copy all of drive C root directory to D:\TEMP (and create if not exist)
without a callback event procedure. Note that this is what the regular
VCopyFile function does.
VCopyFileEx('C:\', 'D:\TEMP', 'MAKETARGETDIR', cbeAll, NIL);
#3 Copy all of drive C root directory to drive Y using no reports, but
will use external read/write block routines.
VCopyFileEx('C:\', 'Y:\', '',
cbeExternReadBlock + cbeExternWriteBlock,
@MyCopyRoutine);
..where an example MyCopyRoutine would read/write the buffer.
#4 Copy all of drive C root directory to D:\TEMP with all global events
reported except cbeIOErr to MyCopyProc.
VCopyFileEx('C:\', 'D:\TEMP', '', cbeAll - cbeIOErr, @MyCopyProc);
..where MyCopyProc could be as example #1.
-*)
{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}
IMPLEMENTATION
Const
coMove = 0;
coNoOverwrite = 1;
coSubDir = 2;
coExactAttr = 3;
coNewer = 4;
coShare = 5;
coAppend = 6;
coMakeTargetDir = 7;
coTargetDirOnly = 8;
coTestMode = 9;
coListFile = 10;
coShow = 11;
{---------------------}
{ Internal file flags }
{---------------------}
iffReadOnly = $01;
iffFilename = 0;
iffAttrib = 1;
iffDate = 2;
iffTime = 3;
iffPackedDate = 4;
iffSize = 5;
iffSource = 0;
iffTarget = 1;
iffAppend = 100;
iffOk = 0;
iffAbort = 1000;
iffRetry = 2000;
iffFail = 3000;
showDelim : STRING = '·';
Type
TFile = RECORD
OrgPath : PathStr; { Original Path (unexpanded) }
Path : PathStr; { Main expanded Path as a passed-in parameter }
WildCard : DirStr; { Wildcards of Path (or InPath) }
Drive : CHAR; { Drive of Path }
OrgDir : DirStr; { Original Directory of Path }
Dir : DirStr; { Directory of Path }
fi : FILE; { FILE type for Path }
FName : PathStr; { Final name to use for copy }
Time : LONGINT; { Date and Time of FName }
Attr : WORD; { Attributes of FName }
Size : LONGINT; { File size of FName }
fiFlag : BYTE; { Bitfield flags for events: }
{ [0] = did file have ReadOnly flag? }
END;
PFile = ^TFile;
{---}
TDTClass = ( Date, DateB, DateA, DateOB, DateOA,
Time, TimeB, TimeA, TimeOB, TimeOA,
MarkPos );
PFileDT = ^TFileDT;
TFileDT = RECORD
Class : TDTClass;
Data : WORD;
Pred : PFileDT;
Next : PFileDT;
END;
{---}
TCopyIData = RECORD
orgFlag : LONGINT; { Original Options flag }
orgTimeout: WORD; { Original Timeout for events seconds) }
orgSeAttr : BYTE; { Original Source searching attribute mask }
opFlag : LONGINT; { Current Options flag }
ShowFlag : BYTE; { Current SHOW parameter features active }
Timeout : WORD; { Current Timeout for events (in seconds) }
seAttr : BYTE; { Current Source searching attribute mask }
seDT : PFileDT; { Search Date/Time link list to comp with file }
ListF : TEXT; { List file instead of searching drive }
ListFName : PathStr; { Assigned list filename }
stFrom : TFile; { Source file information }
stTo : TFile; { Target file information }
rcSearch : SearchRec; { FindFirst/FindNext search record }
Abort : LONGINT; { Error/Abort code }
CBI : TCopyCallBackInfo;
CBIEvents : LONGINT;
CBIProc : TCopyCallBackProc;
END;
PCopyIData = ^TCopyIData;
{────────────────────────────────────────────────────────────────────────────}
Procedure MyCallBackProc( CBI : PCopyCallBackInfo ); Far;
BEGIN
END;
{────────────────────────────────────────────────────────────────────────────}
Function VCopyChkFlag( IData : PCopyIData;
Bit : BYTE ) : BOOLEAN;
BEGIN
VCopyChkFlag := ( IData^.OpFlag AND CBitMapL[Bit] ) <> 0;
END;
{────────────────────────────────────────────────────────────────────────────}
Procedure VCopySetFlag( IData : PCopyIData;
Bit : BYTE );
BEGIN
IData^.OpFlag := ( IData^.OpFlag OR CBitMapL[Bit] );
END;
{────────────────────────────────────────────────────────────────────────────}
Procedure VCopyClearFlag( IData : PCopyIData;
Bit : BYTE );
BEGIN
IData^.OpFlag := ( IData^.OpFlag AND NOT CBitMapL[Bit] );
END;
{────────────────────────────────────────────────────────────────────────────}
Function VCopyChkShowFlag( IData : PCopyIData;
Bit : BYTE ) : BOOLEAN;
BEGIN
VCopyChkShowFlag := ( IData^.ShowFlag AND CBitMapB[Bit] ) <> 0;
END;
{────────────────────────────────────────────────────────────────────────────}
Procedure VCopySetShowFlag( IData : PCopyIData;
Bit : BYTE );
BEGIN
IData^.ShowFlag := ( IData^.ShowFlag OR CBitMapB[Bit] );
END;
{────────────────────────────────────────────────────────────────────────────}
Procedure VCopyClearShowFlag( IData : PCopyIData;
Bit : BYTE );
BEGIN
IData^.ShowFlag := ( IData^.ShowFlag AND NOT CBitMapB[Bit] );
END;
{───────────────────────────────────────────────────────────────────────────}
Function CheckCBI( IData : PCopyIData;
Flag : LONGINT ) : BOOLEAN;
BEGIN
If ( IData^.CBIEvents AND Flag <> 0 ) AND
( @IData^.CBIProc <> NIL ) Then
CheckCBI := TRUE
Else
CheckCBI := FALSE;
END;
{───────────────────────────────────────────────────────────────────────────}
Procedure VCopyWrite( S : STRING );
BEGIN
Write( S );
END;
{───────────────────────────────────────────────────────────────────────────}
Procedure VCopyWriteLn( S : STRING );
BEGIN
VCopyWrite( S );
WriteLn;
END;
{───────────────────────────────────────────────────────────────────────────}
Procedure VCopyMarkIData( IData : PCopyIData );
Var
mkP : PFileDT;
teP : PFileDT;
BEGIN
With IData^ Do
BEGIN
OrgFlag := OpFlag;
OrgTimeout := Timeout;
OrgseAttr := seAttr;
New( teP );
FillChar( teP^, SizeOf(TFileDT), 0 );
{--------------------}
{ Find mark position }
{--------------------}
mkP := IData^.seDT;
If (mkP <> NIL) Then
BEGIN
While (mkP^.Next <> NIL) Do
mkP := mkP^.Next;
teP^.Next := mkP^.Next;
teP^.Pred := mkP;
mkP^.Next := teP;
END
Else
BEGIN
mkP := teP;
mkP^.Pred := NIL;
mkP^.Next := NIL;
IData^.seDT := mkP;
END;
teP^.Class := MarkPos;
teP^.Data := 0;
END;
END;
{───────────────────────────────────────────────────────────────────────────}
Procedure VCopyReleaseIData( IData : PCopyIData );
Var
mkP : PFileDT;
teP : PFileDT;
BEGIN
With IData^ Do
BEGIN
OpFlag := OrgFlag;
Timeout := OrgTimeout;
seAttr := OrgSeAttr;
If (seDT <> NIL) Then
BEGIN
{--------------------}
{ Find mark position }
{--------------------}
mkP := seDT;
While (mkP^.Class <> MarkPos) AND
(mkP <> NIL) Do
mkP := mkP^.Next;
{------------------------------}
{ Dispose afterwards inclusive }
{------------------------------}
If (mkP <> NIL) Then
BEGIN
teP := mkP;
While (teP^.Next <> NIL) Do
BEGIN
teP := mkP^.Next;
If teP <> NIL Then
BEGIN
mkP^.Next := teP^.Next;
Dispose( teP );
END;
END;
If mkP^.Pred <> NIL Then
mkP^.Pred^.Next := mkP^.Next
Else
seDT := NIL;
Dispose( mkP );
END;
END;
END;
END;
{───────────────────────────────────────────────────────────────────────────}
Function VCopySetupDir( IData : PCopyIData;
stPathFrom: PathStr;
stPathTo : PathStr ) : INTEGER;
Var
teName : NameStr;
teExt : ExtStr;
teDir : PathStr;
BEGIN
VCopySetupDir := erVCopy_None;
IData^.stFrom.Path := FExpand(stPathFrom);
IData^.stTo.Path := FExpand(stPathTo);
If DirExist(IData^.stFrom.Path) Then
IData^.stFrom.Path := PutSlash(IData^.stFrom.Path) + '*.*';
{----------------------------------}
{ If MakePathTo flag and indicated }
{ dir doesn't exist, create OrgDir }
{----------------------------------}
If (Pos('*', IData^.stTo.Path) = 0) AND
(Pos('?', IData^.stTo.Path) = 0) Then
teDir := IData^.stTo.Path
Else
BEGIN
teDir := PredDir(IData^.stTo.Path);
Delete(teDir, Length(teDir), 1);
END;
If (VCopyChkFlag(IData, coMakeTargetDir)) AND
(NOT VCopyChkFlag(IData, coTestMode)) AND
(NOT DirExist(teDir)) Then
BEGIN
{------------------------------------------------}
{ Check if target directory is an existing file. }
{------------------------------------------------}
If FileExist(teDir) Then
BEGIN
VCopySetupDir := erVCopy_TargetPathIsFile;
Exit;
END;
MkSubDir( teDir );
END;
{----------------------------------}
If (DirExist(IData^.stTo.Path)) OR
( (NOT DirExist(IData^.stTo.Path)) AND
(VCopyChkFlag(IData, coTestMode)) ) Then
IData^.stTo.Path := PutSlash(IData^.stTo.Path) + '*.*';
IData^.stFrom.WildCard := InDir(IData^.stFrom.Path);
IData^.stTo.WildCard := InDir(IData^.stTo.Path);
FSplit(IData^.stFrom.Path, IData^.stFrom.Dir, teName, teExt);
FSplit(IData^.stTo.Path, IData^.stTo.Dir, teName, teExt);
IData^.stFrom.Drive := IData^.stFrom.Dir[1];
IData^.stTo.Drive := IData^.stTo.Dir[1];
IData^.stFrom.OrgDir := IData^.stFrom.Dir;
IData^.stTo.OrgDir := IData^.stTo.Dir;
END;
{───────────────────────────────────────────────────────────────────────────}
Procedure VCopySetupParams( IData : PCopyIData;
Params : STRING );
Var
Param : STRING;
ParamField : STRING;
ParamData : STRING;
mkP : PFileDT;
teP : PFileDT; { First search Date/Time in link list. STATIC }
DT : DateTime;
PDT : LONGINT;
Class : TDTClass;
L1 : WORD;
Pos1 : BYTE;
Pos2 : BYTE;
BEGIN
Params := UpperString(Params);
Param := '';
REPEAT
Param := GetNextParam(Param, Params);
If Param <> '' Then
BEGIN
ParamField := GetParamName(Param);
If ParamField = 'MOVE' Then
VCopySetFlag(IData, coMove)
Else
If ParamField = 'NOOVERWRITE' Then
VCopySetFlag(IData, coNoOverwrite)
Else
If ParamField = 'SUBDIR' Then
BEGIN
VCopySetFlag(IData, coSubDir);
IData^.seAttr := IData^.seAttr or Directory;
END
Else
If ParamField = 'EXACTATTR' Then
VCopySetFlag(IData, coExactAttr)
Else
If ParamField = 'NEWER' Then
VCopySetFlag(IData, coNewer)
Else
If ParamField = 'SHARE' Then
VCopySetFlag(IData, coShare)
Else
If ParamField = 'APPEND' Then
VCopySetFlag(IData, coAppend)
Else
If ParamField = 'DATE' Then
Class := Date
Else
If ParamField = 'DATEB' Then
Class := DateB
Else
If ParamField = 'DATEA' Then
Class := DateA
Else
If ParamField = 'DATEOB' Then
Class := DateOB
Else
If ParamField = 'DATEOA' Then
Class := DateOA
Else
If ParamField = 'TIME' Then
Class := Time
Else
If ParamField = 'TIMEB' Then
Class := TimeB
Else
If ParamField = 'TIMEA' Then
Class := TimeA
Else
If ParamField = 'TIMEOB' Then
Class := TimeOB
Else
If ParamField = 'TIMEOA' Then
Class := TimeOA
Else
If ParamField = 'MAKETARGETDIR' Then
VCopySetFlag(IData, coMakeTargetDir)
Else
If ParamField = 'TARGETDIRONLY' Then
VCopySetFlag(IData, coTargetDirOnly)
Else
If ParamField = 'TESTMODE' Then
VCopySetFlag(IData, coTestMode)
Else
If ParamField = 'ATTR' Then
BEGIN
ParamData := GetParamData(Param);
For L1 := 1 to Length(ParamData) Do
BEGIN
Case ParamData[L1] of
'A' : IData^.seAttr := IData^.seAttr or Archive;
'S' : IData^.seAttr := IData^.seAttr or SysFile;
'H' : IData^.seAttr := IData^.seAttr or Hidden;
'R' : IData^.seAttr := IData^.seAttr or ReadOnly;
End;
END;
END
Else
If ParamField = 'TIMEOUT' Then
BEGIN
ParamData := GetParamData(Param);
IData^.Timeout := StrToInt(ParamData);
END
Else
If ParamField = 'SHOW' Then
BEGIN
VCopySetFlag(IData, coShow);
ParamData := GetParamData(Param);
For L1 := 1 to Length(ParamData) Do
BEGIN
Case ParamData[L1] of
'F' : VCopySetShowFlag(IData, iffFilename);
'A' : VCopySetShowFlag(IData, iffAttrib);
'D' : VCopySetShowFlag(IData, iffDate);
'T' : VCopySetShowFlag(IData, iffTime);
'P' : VCopySetShowFlag(IData, iffPackedDate);
'S' : VCopySetShowFlag(IData, iffSize);
End;
END;
END;
{-----}
If (Pos('DATE', ParamField) <> 0) OR
(Pos('TIME', ParamField) <> 0) Then
BEGIN
ParamData := GetParamData(Param);
New( teP );
{--------------------}
{ Find mark position }
{--------------------}
mkP := IData^.seDT;
If mkP <> NIL Then
BEGIN
While (mkP^.Next <> NIL) Do
mkP := mkP^.Next;
teP^.Next := mkP^.Next;
teP^.Pred := mkP;
mkP^.Next := teP;
END
Else
BEGIN
mkP := teP;
mkP^.Pred := NIL;
mkP^.Next := NIL;
IData^.seDT := mkP;
END;
teP^.Class := Class;
If Class in [Date..DateOA] Then
BEGIN
FillChar( DT, SizeOf(DateTime), 0 );
Pos1 := Pos('-', ParamData);
If (Pos1 = 0) Then
Pos1 := Pos('/', ParamData);
Pos2 := PosAfter('-', ParamData, Succ(Pos1));
If (Pos2 = 0) Then
Pos2 := PosAfter('/', ParamData, Succ(Pos1));
DT.Month := Word(StrToInt(Copy(
ParamData, 1, Pred(Pos1))));
DT.Day := Word(StrToInt(Copy(
ParamData, Succ(Pos1), Pos2 - Succ(Pos1))));
DT.Year := Word(StrToInt(Copy(
ParamData, Succ(Pos2), Byte(ParamData[0]) - Pos2)));
If (DT.Year < 1900) Then
DT.Year := DT.Year + 1900;
If (DT.Year < 1980) Then
DT.Year := DT.Year + 100;
PackTime(DT, PDT);
teP^.Data := Word( PDT SHR $10 );
END
Else
If Class in [Time..TimeOA] Then
BEGIN
FillChar( DT, SizeOf(DateTime), 0 );
Pos1 := Pos(':', ParamData);
DT.Hour := Word(StrToInt(Copy(
ParamData, 1, Pred(Pos1)) ));
DT.Min := Word(StrToInt(Copy(
ParamData, Succ(Pos1), Byte(ParamData[0]) - Pos2)));
teP^.Data := (DT.Hour * 60) + DT.Min;
END;
END;
END;
UNTIL Param = '';
END;
{───────────────────────────────────────────────────────────────────────────}
Procedure VCopyFindFile( IData : PCopyIData );
{───────────────────────────────────────────────────────────────────────}
Function HourMin( Time : LONGINT ) : WORD;
Var
DT : DateTime;
BEGIN
UnpackTime( Time, DT );
HourMin := ( DT.Hour * 60 ) + DT.Min;
END;
{───────────────────────────────────────────────────────────────────────}
Function GetDOSFile : BOOLEAN;
Var
stFirst : BOOLEAN;
OK : BOOLEAN;
stDir : DirStr;
P : PFileDT;
BEGIN
{----------------------------}
{ Setup first directory read }
{----------------------------}
stFirst := FALSE;
If (IData^.rcSearch.Name = '') Then
BEGIN
{---------------------------------------}
{ Search for *.* to find subdirectories }
{---------------------------------------}
FindFirst( IData^.stFrom.Dir + '*.*',
IData^.seAttr,
IData^.rcSearch );
stFirst := TRUE;
END;
REPEAT
If NOT stFirst Then
FindNext( IData^.rcSearch );
IData^.stFrom.Time := IData^.rcSearch.Time;
IData^.stFrom.Attr := IData^.rcSearch.Attr;
IData^.stFrom.Size := IData^.rcSearch.Size;
{================================}
{ CHECK SEARCH OPTIONS }
{================================}
OK := TRUE;
{-------------------------------------------}
{ Check filters - attribute, filetime, etc. }
{-------------------------------------------}
{-----------------------------------------}
{ Bypass if current or previous directory }
{-----------------------------------------}
If ( IData^.rcSearch.Name = '.' ) OR
( IData^.rcSearch.Name = '..' ) Then
OK := FALSE;
{--------------------------------}
{ Test if found file masked with }
{ source wildcard is still valid }
{--------------------------------}
If (OK) AND
( MaskWildCards(
PutDot( IData^.rcSearch.Name ),
IData^.stFrom.WildCard ) <> PutDot( IData^.rcSearch.Name ) ) AND
( IData^.rcSearch.Attr AND Directory <> Directory ) Then
OK := FALSE;
{------------------}
{ Check attributes }
{------------------}
{ 1. Has ATTR=ASHR occured? }
{ 2. All directories are exempt from check }
{ 3. Is ExactAttr flag set? }
{ 4. Does found file's attr and ATTR= match? }
If (OK) AND
(IData^.seAttr <> 0) AND
(IData^.seAttr <> Directory) AND
(IData^.rcSearch.Attr AND Directory <> Directory) AND
(VCopyChkFlag(IData, coExactAttr)) AND
(IData^.rcSearch.Attr <> IData^.seAttr AND NOT Directory) Then
OK := FALSE;
{-----------------------}
{ Check Date/Time flags }
{-----------------------}
If (OK) AND
(IData^.seDT <> NIL) Then
BEGIN
P := IData^.seDT;
REPEAT
Case P^.Class Of
MarkPos : ;
{---}
Date :
If (IData^.stFrom.Time SHR $10) <>
(P^.Data) Then
OK := FALSE;
{---}
DateB :
If (IData^.stFrom.Time SHR $10) >=
(P^.Data) Then
OK := FALSE;
{---}
DateA :
If (IData^.stFrom.Time SHR $10) <=
(P^.Data) Then
OK := FALSE;
{---}
DateOB :
If (IData^.stFrom.Time SHR $10) >
(P^.Data) Then
OK := FALSE;
{---}
DateOA :
If (IData^.stFrom.Time SHR $10) <
(P^.Data) Then
OK := FALSE;
{---}
Time :
If HourMin(IData^.stFrom.Time) <>
HourMin(P^.Data) Then
OK := FALSE;
{---}
TimeB :
If HourMin(IData^.stFrom.Time) >=
HourMin(P^.Data) Then
OK := FALSE;
{---}
TimeA :
If HourMin(IData^.stFrom.Time) <=
HourMin(P^.Data) Then
OK := FALSE;
{---}
TimeOB :
If HourMin(IData^.stFrom.Time) >
HourMin(P^.Data) Then
OK := FALSE;
{---}
TimeOA :
If HourMin(IData^.stFrom.Time) <
HourMin(P^.Data) Then
OK := FALSE;
End;
P := P^.Next;
UNTIL (NOT OK) OR (P = NIL);
END;
{-----------------------}
{ Enter if subdirectory }
{-----------------------}
If ( (OK) AND
(IData^.rcSearch.Attr AND Directory = Directory) AND
(VCopyChkFlag(IData, coSubDir)) AND
(DosError = 0) ) Then
BEGIN
OK := FALSE;
stDir := PutSlash( IData^.stFrom.Dir + IData^.rcSearch.Name );
If (stDir <> IData^.stTo.OrgDir) Then
BEGIN
If (NOT DirExist( IData^.stTo.Dir + IData^.rcSearch.Name )) AND
(NOT VCopyChkFlag(IData, coTargetDirOnly)) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
BEGIN
MkDir( IData^.stTo.Dir + IData^.rcSearch.Name );
{-------------------------------------}
{ Preserve source directory attribute }
{ list into the new target directory }
{-------------------------------------}
Assign( IData^.stTo.fi,
IData^.stTo.Dir + IData^.rcSearch.Name );
If ( NOT VCopyChkFlag(IData, coTestMode) ) Then
SetFAttr( IData^.stTo.fi, IData^.stFrom.Attr );
END;
IData^.stFrom.Dir :=
PutSlash( IData^.stFrom.Dir + IData^.rcSearch.Name );
If (NOT VCopyChkFlag(IData, coTargetDirOnly)) Then
IData^.stTo.Dir :=
PutSlash( IData^.stTo.Dir + IData^.rcSearch.Name );
FillChar( IData^.rcSearch, SizeOf(SearchRec), 0 );
FindFirst( IData^.stFrom.Dir + '*.*',
IData^.seAttr,
IData^.rcSearch );
END;
END;
{-----------------------------}
{ Exit subdirectory if at end }
{-----------------------------}
If ( (DosError = 18) AND
(VCopyChkFlag(IData, coSubDir)) AND
(IData^.stFrom.Dir <> IData^.stFrom.OrgDir)) Then
BEGIN
OK := FALSE;
stDir := InDir( IData^.stFrom.Dir );
IData^.stFrom.Dir := PredDir( IData^.stFrom.Dir );
If (NOT VCopyChkFlag(IData, coTargetDirOnly)) Then
IData^.stTo.Dir := PredDir( IData^.stTo.Dir );
FillChar( IData^.rcSearch, SizeOf(SearchRec), 0 );
FindFirst( IData^.stFrom.Dir + '*.*',
IData^.seAttr,
IData^.rcSearch );
While ( (IData^.rcSearch.Name <> stDir) AND (DosError = 0) ) Do
FindNext( IData^.rcSearch );
stDir := IData^.stFrom.Dir + stDir;
If ( VCopyChkFlag( IData, coMove ) ) AND
( DirEmpty( stDir ) ) Then
BEGIN
If ( NOT VCopyChkFlag( IData, coTestMode ) ) Then
RmDir( stDir );
END;
END;
stFirst := FALSE;
UNTIL OK or (DosError <> 0);
If (DosError = 18) AND (IData^.stFrom.Dir = IData^.stFrom.OrgDir) Then
OK := FALSE;
GetDOSFile := OK;
END;
{───────────────────────────────────────────────────────────────────────}
Function GetListFile : BOOLEAN;
Var
stDir : DirStr;
S : STRING;
SourceName : STRING;
TargetName : STRING;
Params : STRING;
OK : BOOLEAN;
BEGIN
OK := TRUE;
{-----------------------------}
{ Open file if not opened yet }
{-----------------------------}
If Byte(TextRec( IData^.ListF ).Name[0]) = 0 Then
BEGIN
Assign( IData^.ListF, IData^.ListFName );
Reset( IData^.ListF );
END;
{-----------------------}
{ Check for end of file }
{-----------------------}
If ( Eof(IData^.ListF) ) AND
( IData^.rcSearch.Name = '' ) Then
BEGIN
Close( IData^.ListF );
FillChar( IData^.ListF, SizeOf(IData^.ListF), 0 );
{--------------------}
{ Release IData Mark }
{--------------------}
VCopyReleaseIData( IData );
OK := FALSE;
END;
{-----------------------------------------}
{ If more information available, continue }
{-----------------------------------------}
If OK Then
REPEAT
OK := TRUE;
If IData^.rcSearch.Name = '' Then
BEGIN
{--------------------}
{ Release IData Mark }
{--------------------}
VCopyReleaseIData( IData );
ReadLn(IData^.ListF, S);
SourceName := TakeWords( S, 1 );
TargetName := TakeWords( S, 1 );
Params := TakeWords( S, 1 );
If SourceName <> '' Then
BEGIN
SourceName := FExpand( SourceName );
{------------------------------------------}
{ Set parameters if no target is specified }
{------------------------------------------}
If (TargetName[1] = '/') Then
BEGIN
Params := CopyStr( TargetName, 2, Pred(Byte(TargetName[0])) );
TargetName := '';
END;
If (TargetName = '') Then
TargetName := FExpand( IData^.stTo.OrgPath );
If (Byte(Params[0]) > 0) AND
(Params[1] = '/') Then
Delete(Params, 1, 1);
{------------}
{ Mark IData }
{------------}
VCopyMarkIData( IData );
{---------------------------------}
{ Check for additional parameters }
{---------------------------------}
If (Params <> '') Then
VCopySetupParams( IData, Params );
{------------------------------------}
{ Setup source/target directory info }
{------------------------------------}
IData^.Abort := VCopySetupDir( IData, SourceName, TargetName );
If (IData^.Abort <> erVCopy_None) Then
SourceName := '';
END;
END;
If (Byte(SourceName[0]) = 0) Then
OK := FALSE
Else
BEGIN
If (NOT GetDOSFile) Then
BEGIN
IData^.rcSearch.Name := '';
OK := FALSE;
END
Else
BEGIN
{================================}
{ CHECK SEARCH OPTIONS }
{================================}
{---------------------------------------------}
{ Check for TargetDirOnly - otherwise, create }
{ subdirectory of source file for target file }
{---------------------------------------------}
If (NOT VCopyChkFlag(IData, coTargetDirOnly)) Then
BEGIN
stDir := IData^.stTo.OrgDir +
Copy( IData^.stFrom.Dir, 4, Byte( IData^.stFrom.Dir[0] ) - 3 );
IData^.stTo.Dir := stDir;
If (NOT DirExist( IData^.stTo.Dir )) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
MkSubDir( UnPutSlash( IData^.stTo.Dir ) );
END;
END;
END;
UNTIL OK or ( Eof( IData^.ListF ) );
GetListFile := OK;
END;
{───────────────────────────────────────────────────────────────────────}
Procedure SetupToFile;
BEGIN
IData^.stFrom.FName := IData^.stFrom.Dir + IData^.rcSearch.Name;
IData^.stTo.FName := IData^.stTo.Dir + UnPutDot(
MaskWildcards( IData^.rcSearch.Name, IData^.stTo.Wildcard ) );
IData^.stTo.Time := GetFileTime( IData^.stTo.FName );
IData^.stTo.Attr := GetFileAttr( IData^.stTo.FName );
IData^.stTo.Size := GetFileSize( IData^.stTo.FName );
END;
{───────────────────────────────────────────────────────────────────────}
BEGIN
If (VCopyChkFlag(IData, coListFile)) Then
BEGIN
If GetListFile Then
BEGIN
SetupToFile;
Exit;
END;
END
Else
If GetDOSFile Then
BEGIN
SetupToFile;
Exit;
END;
{-------------------------------------}
{ If still here, assume no more files }
{-------------------------------------}
IData^.stFrom.FName := '';
IData^.stTo.FName := '';
END;
{────────────────────────────────────────────────────────────────────────────}
Function VCopyFileLow( IData : PCopyIData ) : INTEGER;
Type
TBuffer = Array[0..0] of BYTE;
PBuffer = ^TBuffer;
Var
Buf : PBuffer;
Count : WORD;
NumRead : WORD;
NumWritten : WORD;
IOErr : Integer;
Label
ReRead,
ReWrite,
AbortCopy;
BEGIN
Count := VTypesu.maxArrSize;
If (MaxAvail < Count) Then
Count := MaxAvail;
GetMem( Buf, Count );
REPEAT
VMultiDO( 0 );
{============}
{ READ BLOCK }
{============}
REREAD:
{------------------------------------}
{ Source file external read callback }
{------------------------------------}
If CheckCBI(IData, cbeExternReadBlock) Then
BEGIN
IData^.CBI.Event := cbeExternReadBlock;
IData^.CBI.StrParam := IData^.stFrom.FName;
IData^.CBI.NumParam1 := Count;
IData^.CBI.PtrParam1 := Buf;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
If (IData^.CBI.RetCode = iffAbort) OR
(IData^.CBI.RetCode = iffFail) Then
Goto AbortCopy;
IOErr := IData^.CBI.RetCode;
NumRead := IData^.CBI.NumParam1;
END
Else
BEGIN
{---------------------------}
{ Source file read callback }
{---------------------------}
If CheckCBI(IData, cbeReadBlock) Then
BEGIN
IData^.CBI.Event := cbeReadBlock;
IData^.CBI.StrParam := IData^.stFrom.FName;
IData^.CBI.NumParam1 := Count;
IData^.CBI.PtrParam1 := Buf;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
If (IData^.CBI.RetCode = iffAbort) OR
(IData^.CBI.RetCode = iffFail) Then
Goto AbortCopy;
END;
{------------}
{ Read block }
{------------}
{$I-}
BlockRead( IData^.stFrom.fi, Buf^, Count, NumRead );
IOErr := IOResult;
{$I+}
END;
{-----------------}
{ Check for error }
{-----------------}
If (IOErr <> 0) AND CheckCBI(IData, cbeIOErr) Then
BEGIN
IData^.CBI.Event := cbeIOErr;
IData^.CBI.NumParam1 := IOErr;
IData^.CBI.NumParam2 := cbsRead;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
If (IData^.CBI.RetCode = iffAbort) OR
(IData^.CBI.RetCode = iffFail) Then
Goto AbortCopy;
If (IData^.CBI.RetCode = iffRetry) Then
Goto ReRead;
END;
{=============}
{ WRITE BLOCK }
{=============}
REWRITE:
{-------------------------------------}
{ Target file external write callback }
{-------------------------------------}
If CheckCBI(IData, cbeExternWriteBlock) Then
BEGIN
IData^.CBI.Event := cbeExternWriteBlock;
IData^.CBI.StrParam := IData^.stTo.FName;
IData^.CBI.NumParam1 := NumRead;
IData^.CBI.PtrParam1 := Buf;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
If (IData^.CBI.RetCode = iffAbort) OR
(IData^.CBI.RetCode = iffFail) Then
Goto AbortCopy;
IOErr := IData^.CBI.RetCode;
NumWritten := IData^.CBI.NumParam1;
END
Else
BEGIN
{----------------------------}
{ Target file write callback }
{----------------------------}
If CheckCBI(IData, cbeWriteBlock) Then
BEGIN
IData^.CBI.Event := cbeWriteBlock;
IData^.CBI.StrParam := IData^.stTo.FName;
IData^.CBI.NumParam1 := NumRead;
IData^.CBI.PtrParam1 := Buf;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
If (IData^.CBI.RetCode = iffAbort) OR
(IData^.CBI.RetCode = iffFail) Then
Goto AbortCopy;
END;
{-------------}
{ Write block }
{-------------}
{$I-}
BlockWrite( IData^.stTo.fi, Buf^, NumRead, NumWritten );
IOErr := IOResult;
{$I+}
END;
{-----------------}
{ Check for error }
{-----------------}
If (IOErr <> 0) AND CheckCBI(IData, cbeIOErr) Then
BEGIN
IData^.CBI.Event := cbeIOErr;
IData^.CBI.NumParam1 := IOErr;
IData^.CBI.NumParam2 := cbsWrite;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
If (IData^.CBI.RetCode = iffAbort) OR
(IData^.CBI.RetCode = iffFail) Then
Goto AbortCopy;
If (IData^.CBI.RetCode = iffRetry) Then
Goto ReWrite;
END;
UNTIL ( ( NumRead = 0 ) AND ( IOErr = 0 ) ) OR
( NumWritten <> NumRead );
ABORTCOPY:
{$I+}
FreeMem( Buf, Count );
If (IData^.CBI.RetCode = iffFail) Then
VCopyFileLow := erVCopy_Fail
Else
If (IData^.CBI.RetCode = iffAbort) Then
VCopyFileLow := erVCopy_None
Else
If ( (NumWritten <> NumRead) AND (NumRead <> 0) ) Then
VCopyFileLow := erVCopy_NoRoom
Else
VCopyFileLow := erVCopy_None;
END;
{────────────────────────────────────────────────────────────────────────────}
Function ShareFile( Var fi : FILE;
Var Timeout : WORD ) : INTEGER;
Var
Clock1 : TSwatch;
Clock2 : TSwatch;
BEGIN
Clock1 := 0;
Clock2 := 0;
{$I-}
Reset( fi, 1 );
{$I+}
If ( IOResult in [0, 162] ) Then
BEGIN
Clock1 := CurrSwatch;
Repeat
Clock2 := CurrSwatch;
{$I-}
Reset( fi, 1 );
{$I+}
Until ( IOResult <> 162 ) OR
( Clock2 - Clock1 > Timeout );
END;
If ( Clock2 - Clock1 > Timeout ) Then
ShareFile := erVCopy_Timeout
Else
ShareFile := erVCopy_None;
END;
{────────────────────────────────────────────────────────────────────────────}
Procedure VCopyShowError( ErrNo : WORD;
IData : PCopyIData );
Var
S : STRING;
BEGIN
Case ErrNo of
erVCopy_None :
S := '';
erVCopy_SamePath :
BEGIN
S := 'Can''t ';
If VCopyChkFlag(IData, coMove) Then
S := S + 'move'
Else
S := S + 'copy';
S := S + ' file to itself "' + LowerString(IData^.stTo.FName) + '"';
END;
erVCopy_NoExistFileFrom :
S := 'Source file(s) does not exist';
erVCopy_NoExistFileTo :
S := 'Target file(s) does not exist';
erVCopy_NoExistDirFrom :
S := 'Source path does not exist';
erVCopy_NoExistDirTo :
S := 'Target path does not exist';
erVCopy_Timeout :
S := 'Timeout occured during operation';
erVCopy_NoRoom :
S := 'Insufficient disk space for "' +
LowerString(IData^.stTo.FName) + '"';
erVCopy_ListFileNotFound :
S := 'List file "' + LowerString(IData^.ListFName) + '" not found';
erVCopy_TargetPathIsFile :
S := 'Target directory "' + LowerString(IData^.stTo.Path) + '" is an existing file';
erVCopy_Fail :
S := 'Failed copying of file(s)';
End;
VCopyWriteLn(S + '.');
END;
{────────────────────────────────────────────────────────────────────────────}
Procedure VCopyDoErrorReport( IData : PCopyIData;
Var Error : LONGINT );
BEGIN
{-----------------------------}
{ If show flag, display error }
{-----------------------------}
If (VCopyChkFlag(IData, coShow)) Then
VCopyShowError( Error, IData );
{----------------------------------------------------}
{ If callback procedure active, do an error callback }
{----------------------------------------------------}
If CheckCBI(IData, cbeVCopyErr) Then
BEGIN
IData^.CBI.Event := cbeVCopyErr;
IData^.CBI.NumParam1 := Error;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
END
END;
{────────────────────────────────────────────────────────────────────────────}
Function ShowFileStr( IData : PCopyIData;
WhichFile : BYTE ) : STRING;
Var
ShowF : STRING;
L1 : LONGINT;
L2 : LONGINT;
DT : TDateTime;
DTEx : TDateTimeEx;
S1 : STRING;
stFil : PFile; { used as TFile(stFil^) }
BEGIN
Case WhichFile of
iffSource : stFil := PFile( @IData^.stFrom ); { Source file }
iffTarget : stFil := PFile( @IData^.stTo ); { Target file }
End;
With IData^ Do
BEGIN
ShowF := '';
If VCopyChkShowFlag(IData, iffFilename) Then
ShowF := LowerString(TFile(stFil^).FName) + ' ';
ShowF := ShowF + '(';
For L1 := iffAttrib to iffSize Do
BEGIN
If VCopyChkShowFlag(IData, L1) Then
Case L1 of
{---}
iffAttrib :
If TFile(stFil^).Attr <> 0 Then
BEGIN
L2 := Byte(ShowF[0]);
If (TFile(stFil^).Attr AND Archive = Archive) Then
ShowF := ShowF + 'A';
If (TFile(stFil^).Attr AND SysFile = SysFile) Then
ShowF := ShowF + 'S';
If (TFile(stFil^).Attr AND Hidden = Hidden) Then
ShowF := ShowF + 'H';
If (TFile(stFil^).Attr AND ReadOnly = ReadOnly) Then
ShowF := ShowF + 'R';
If L2 < Byte(ShowF[0]) Then
ShowF := ShowF + ShowDelim;
END;
{---}
iffDate :
If TFile(stFil^).Time <> 0 Then
BEGIN
UnpackTime( TFile(stFil^).Time, DT );
DateTimeToEx( DT, DTEx );
ShowF := ShowF +
VDatesMaskStr( DTEx, vcDateStr ) + ShowDelim;
END;
{---}
iffTime :
If TFile(stFil^).Time <> 0 Then
BEGIN
UnpackTime( TFile(stFil^).Time, DT );
DateTimeToEx( DT, DTEx );
ShowF := ShowF +
VDatesMaskStr( DTEx, vcTimeStr ) + ShowDelim;
END;
{---}
iffPackedDate :
If TFile(stFil^).Time <> 0 Then
BEGIN
UnpackTime( TFile(stFil^).Time, DT );
DateTimeToEx( DT, DTEx );
S1 := VDatesMaskStr( DTEx, vcPackDateStr );
If (S1[1] = ' ') Then
Delete(S1, 1, 1);
ShowF := ShowF + S1 + ShowDelim;
END;
{---}
iffSize :
If TFile(stFil^).Size <> 0 Then
ShowF := ShowF + AddCommas( IntToStr( TFile(stFil^).Size ) ) +
ShowDelim;
End;
END;
If (ShowF[Byte(ShowF[0])] <> '(') Then
BEGIN
Delete( ShowF,
Byte(ShowF[0]) - Pred(Byte(ShowDelim[0])),
Byte(ShowDelim[0]) );
ShowF := ShowF + ') ';
END
Else
Delete(ShowF, Byte(ShowF[0]), 1);
END;
ShowFileStr := ShowF;
END;
{────────────────────────────────────────────────────────────────────────────}
Function ShowTypeStr( IData : PCopyIData ) : STRING;
Var
ShowType : STRING; { Show parameter delimiter }
BEGIN
With IData^ Do
BEGIN
If VCopyChkFlag(IData, coMove) Then
ShowType := '->'
Else
ShowType := '=>';
If (VCopyChkFlag(IData, coAppend)) AND
(FileExist(stTo.FName)) Then
ShowType := ShowType + '>';
END;
ShowTypeStr := ShowType;
END;
{────────────────────────────────────────────────────────────────────────────}
Function VCopyFileEx( stPathFrom : PathStr;
stPathTo : PathStr;
Params : STRING;
CBEvents : LONGINT;
CBProc : PCopyCallBackProc ) : INTEGER;
Var
L1,
L2 : WORD;
IData : PCopyIData; { semi-"global" data within this structure }
nfCount : WORD;
Err : INTEGER;
teDT : PFileDT; { Temporary Date/Time Link-list pointer }
Label
DeInit;
BEGIN
{--------------------}
{ Init instance data }
{--------------------}
New( IData );
FillChar( IData^, SizeOf( TCopyIData ), 0 );
With IData^ Do
BEGIN
{--------------}
{ Set up flags }
{--------------}
CBIEvents:= CBEvents;
CBIProc := TCopyCallBackProc(CBProc);
seAttr := 0;
Timeout := 30;
VCopySetupParams( IData, Params );
VCopyFileEx := erVCopy_None;
{------------------------------}
{ Save original (default) path }
{------------------------------}
stFrom.OrgPath := stPathFrom;
stTo.OrgPath := stPathTo;
{---------------}
{ Get list file }
{---------------}
If stPathFrom[1] = '@' Then
BEGIN
ListFName := FExpand(
Copy( stPathFrom, 2, Byte(stPathFrom[0]) - 1 ) );
stPathFrom := '';
If (NOT FileExist(ListFName)) Then
BEGIN
Abort := erVCopy_ListFileNotFound;
Goto DeInit;
END;
VCopySetFlag(IData, coListFile);
END;
OrgFlag := OpFlag;
OrgTimeout := Timeout;
OrgseAttr := seAttr;
{---------------------------------}
{ Set up directory and file paths }
{---------------------------------}
Abort := VCopySetupDir( IData, stPathFrom, stPathTo );
If (Abort <> erVCopy_None) Then
Goto DeInit;
{---------------------------------}
{ Trap for invalid directory info }
{---------------------------------}
If (stFrom.Dir + stFrom.Wildcard) =
(stTo.Dir + stTo.Wildcard) Then
BEGIN
Abort := erVCopy_SamePath;
Goto DeInit;
END;
If NOT DirExist(stFrom.Dir) Then
BEGIN
Abort := erVCopy_NoExistDirFrom;
Goto DeInit;
END;
If (NOT DirExist(stTo.Dir)) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
BEGIN
Abort := erVCopy_NoExistDirTo;
Goto DeInit;
END;
{═══════════════}
{═ BEGIN VCOPY ═}
{═══════════════}
nfCount := 0;
Abort := erVCopy_None;
REPEAT
{---------------}
{ Get next file }
{---------------}
VCopyFindFile( IData );
If (stFrom.FName <> '') Then
BEGIN
{--------------------------------------------}
{ Check if target file exists. If not, }
{ continue. If so and overwrite flag, then }
{ continue. }
{--------------------------------------------}
If ( (NOT FileExist(stTo.FName)) OR
( (FileExist(stTo.FName) AND
(NOT VCopyChkFlag(IData, coNoOverwrite))) ) ) Then
BEGIN
{-----------------------------------}
{ If newer flag and source file is }
{ newer than target file, continue. }
{-----------------------------------}
If ( (NOT VCopyChkFlag(IData, coNewer)) OR
( (VCopyChkFlag(IData, coNewer)) AND
(stFrom.Time > stTo.Time) ) ) Then
BEGIN
{------------------------------}
{ If show flag, display source }
{ and type information }
{------------------------------}
If VCopyChkFlag(IData, coShow) Then
VCopyWrite(ShowFileStr(IData, iffSource) +
ShowTypeStr(IData) + ' ');
{---------------------------}
{ If not append flag and }
{ target file exists, erase }
{---------------------------}
If (NOT VCopyChkFlag(IData, coAppend)) AND
(FileExist(stTo.FName)) Then
BEGIN
Assign(stTo.fi, stTo.FName);
If VCopyChkFlag(IData, coShare) Then
Abort := ShareFile( stTo.fi, Timeout );
If (Abort = erVCopy_None) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
BEGIN
{-----------------------------}
{ If target has ReadOnly }
{ flag, then clear flag first }
{-----------------------------}
If ((stTo.Attr AND ReadOnly) = ReadOnly) Then
SetFAttr( stTo.fi,
stTo.Attr AND NOT ReadOnly );
Erase(stTo.fi);
END;
END;
{-----------------------}
{ Check for a fast move }
{-----------------------}
If (VCopyChkFlag(IData, coMove)) AND
(stFrom.Drive = stTo.Drive) AND
(NOT VCopyChkFlag(IData, coAppend)) Then
BEGIN
{-----------------------------------}
{ fast move - same drive, no append }
{-----------------------------------}
Assign(stTo.fi, stFrom.FName);
If VCopyChkFlag(IData, coShare) Then
Abort := ShareFile( stTo.fi, Timeout );
If (Abort = erVCopy_None) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
Rename(stTo.fi, stTo.FName);
stTo.Attr := stFrom.Attr;
stTo.Time := stFrom.Time;
stTo.Size := stTo.Size;
END
Else
BEGIN
{-----------}
{ Copy file }
{-----------}
Assign(stFrom.fi, stFrom.FName);
Assign(stTo.fi, stTo.FName);
{------------------------------}
{ If source has readonly flag, }
{ set internal flag and clear. }
{------------------------------}
If ((stFrom.Attr AND ReadOnly) = ReadOnly) Then
BEGIN
stFrom.fiFlag := stFrom.fiFlag OR iffReadOnly;
stFrom.Attr := stFrom.Attr AND NOT ReadOnly;
If (NOT VCopyChkFlag(IData, coTestMode)) Then
SetFAttr(stFrom.fi, stFrom.Attr);
END;
{------------------------------}
{ If target had readonly flag, }
{ set internal flag and clear. }
{------------------------------}
If ((stTo.Attr AND ReadOnly) = ReadOnly) Then
BEGIN
stTo.fiFlag := stTo.fiFlag OR iffReadOnly;
stTo.Attr := stTo.Attr AND NOT ReadOnly;
If (NOT VCopyChkFlag(IData, coTestMode)) Then
SetFAttr(stTo.fi, stTo.Attr);
END;
If VCopyChkFlag(IData, coShare) Then
Abort := ShareFile( stFrom.fi, Timeout );
{------------------}
{ Open source file }
{------------------}
If (Abort = erVCopy_None) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
BEGIN
{---------------------------------}
{ Source file reset open callback }
{---------------------------------}
If CheckCBI(IData, cbeSourceOpen) Then
BEGIN
IData^.CBI.Event := cbeSourceOpen;
IData^.CBI.StrParam := stFrom.FName;
IData^.CBI.PtrParam1 := NIL;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
END;
Reset(stFrom.fi, 1);
END;
{------------------}
{ Open target file }
{------------------}
{------------------------------------}
{ If append flag, goto EOF of target }
{------------------------------------}
If (VCopyChkFlag(IData, coAppend)) AND
(FileExist(stTo.FName)) Then
BEGIN
If VCopyChkFlag(IData, coShare) Then
Abort := ShareFile( stTo.fi, Timeout );
If (Abort = erVCopy_None) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
BEGIN
{----------------------------------}
{ Target file append open callback }
{----------------------------------}
If CheckCBI(IData, cbeTargetOpen) Then
BEGIN
IData^.CBI.Event := cbeTargetOpen;
IData^.CBI.StrParam := stTo.FName;
IData^.CBI.NumParam1 := iffAppend;
IData^.CBI.PtrParam1 := NIL;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
END;
Reset(stTo.fi, 1);
Seek(stTo.fi, stTo.Size);
END;
END
Else
BEGIN
If VCopyChkFlag(IData, coShare) Then
Abort := ShareFile( stTo.fi, Timeout );
If (Abort = erVCopy_None) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
BEGIN
{-----------------------------------}
{ Target file rewrite open callback }
{-----------------------------------}
If CheckCBI(IData, cbeTargetOpen) Then
BEGIN
IData^.CBI.Event := cbeTargetOpen;
IData^.CBI.StrParam := stTo.FName;
IData^.CBI.NumParam1 := 0;
IData^.CBI.PtrParam1 := NIL;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
END;
ReWrite(stTo.fi, 1);
END;
END;
{------------------}
{ Do physical copy }
{------------------}
If (NOT VCopyChkFlag(IData, coTestMode)) Then
Abort := VCopyFileLow( IData )
Else
Abort := erVCopy_None;
{----------------------}
{ If all ok, continue. }
{----------------------}
If Abort = erVCopy_None Then
BEGIN
{-----------------------------}
{ Preserve attribute and time }
{-----------------------------}
If (NOT VCopyChkFlag(IData, coTestMode)) Then
BEGIN
{----------------------------}
{ Source file close callback }
{----------------------------}
If CheckCBI(IData, cbeSourceClose) Then
BEGIN
IData^.CBI.Event := cbeSourceClose;
IData^.CBI.StrParam := stFrom.FName;
IData^.CBI.PtrParam1 := NIL;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
END;
Close(stFrom.fi);
{----------------------------}
{ Target file close callback }
{----------------------------}
If CheckCBI(IData, cbeTargetClose) Then
BEGIN
IData^.CBI.Event := cbeTargetClose;
IData^.CBI.StrParam := stTo.FName;
IData^.CBI.PtrParam1 := NIL;
IData^.CBI.RetCode := 0;
IData^.CBIProc( @IData^.CBI );
END;
{-------------------------}
{ Preserve time in target }
{-------------------------}
SetFTime( stTo.fi, stFrom.Time );
Close(stTo.fi);
END;
{------------------------------}
{ Preserve attributes in files }
{------------------------------}
{------------------------------}
{ If source had readonly flag, }
{ reset internal flag and set. }
{------------------------------}
If ((stFrom.fiFlag AND iffReadOnly) = iffReadOnly) Then
BEGIN
stFrom.fiFlag := stFrom.fiFlag AND NOT iffReadOnly;
stFrom.Attr := stFrom.Attr OR ReadOnly;
If (NOT VCopyChkFlag(IData, coTestMode)) Then
SetFAttr( stFrom.fi, stFrom.Attr );
END;
{------------------------------}
{ If target had readonly flag, }
{ reset internal flag and set. }
{------------------------------}
If ((stTo.fiFlag AND iffReadOnly) = iffReadOnly) Then
BEGIN
stTo.fiFlag := stTo.fiFlag AND NOT iffReadOnly;
stTo.Attr := stTo.Attr OR ReadOnly;
If (NOT VCopyChkFlag(IData, coTestMode)) Then
SetFAttr( stTo.fi, stTo.Attr );
END;
{---------------------------------}
{ If internal attr flag = 0, make }
{ target attr same as source attr }
{---------------------------------}
If (stTo.Attr = 0) Then
stTo.Attr := stFrom.Attr;
{----------------------}
{ Set target attribute }
{----------------------}
If (NOT VCopyChkFlag(IData, coTestMode)) Then
SetFAttr( stTo.fi, stFrom.Attr );
{---------------------------------}
{ If move flag, then erase source }
{---------------------------------}
If VCopyChkFlag(IData, coMove) Then
BEGIN
If VCopyChkFlag(IData, coShare) Then
Abort := ShareFile( stFrom.fi, Timeout );
If (Abort = erVCopy_None) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
BEGIN
ReWrite(stFrom.fi, 1);
Close(stFrom.fi);
Erase(stFrom.fi);
END;
END;
END;
END;
If Abort = erVCopy_None Then
Inc(nfCount);
If VCopyChkFlag(IData, coShow) Then
BEGIN
stTo.Attr := GetFileAttr( stTo.FName );
stTo.Time := GetFileTime( stTo.FName );
stTo.Size := GetFileSize( stTo.FName );
{-----------------------------------}
{ If show flag, display target info }
{-----------------------------------}
VCopyWriteLn(ShowFileStr(IData, iffTarget));
END;
END;
END
Else
BEGIN
{-----------------------------------}
{ Since target file exists and }
{ nooverwrite flag, check for move }
{ flag. If so, delete source file. }
{-----------------------------------}
If (VCopyChkFlag(IData, coMove)) Then
BEGIN
Assign(stFrom.fi, stFrom.FName);
If VCopyChkFlag(IData, coShare) Then
Abort := ShareFile( stFrom.fi, Timeout );
If (Abort = erVCopy_None) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
BEGIN
ReWrite(stFrom.fi, 1);
Close(stFrom.fi);
Erase(stFrom.fi);
END;
END;
END;
END;
UNTIL (stFrom.FName = '') or (Abort <> erVCopy_None);
{------------------------------}
{ If show flag, display number }
{ of files transferred. }
{------------------------------}
If VCopyChkFlag(IData, coShow) Then
BEGIN
VCopyWrite(' ' + IntToStr(nfCount) + ' file(s) ');
If VCopyChkFlag(IData, coMove) Then
VCopyWriteLn('moved')
Else
VCopyWriteLn('copied');
END;
{-------------------------------}
{ Remove source-first directory }
{ upon a subdirectory move. }
{-------------------------------}
If ( (VCopyChkFlag(IData, coSubDir)) AND
(VCopyChkFlag(IData, coMove)) AND
(Abort = erVCopy_None) ) Then
BEGIN
If (DirEmpty(stFrom.OrgDir)) AND
(NOT VCopyChkFlag(IData, coTestMode)) Then
RmDir( Copy( PutSlash(stFrom.OrgDir),
1,
Pred(Length(stFrom.OrgDir)) ) );
END;
{-------}
DEINIT:
{-------}
{----------------------------}
{ Delete date/time link list }
{----------------------------}
If seDT <> NIL Then
BEGIN
While (seDT^.Next <> NIL) Do
BEGIN
teDT := seDT^.Next;
seDT^.Next := teDT^.Next;
Dispose( teDT );
END;
Dispose( seDT );
END;
{---------------------------------}
{ If error occured then call the }
{ error report procedure. }
{---------------------------------}
If (Abort <> erVCopy_None) Then
VCopyDoErrorReport( IData, Abort );
VCopyFileEx := Abort;
END;
{----------------------}
{ DeInit instance data }
{----------------------}
Dispose( IData );
END;
{────────────────────────────────────────────────────────────────────────────}
Function VCopyFile( stPathFrom : PathStr;
stPathTo : PathStr;
Params : STRING ) : INTEGER;
BEGIN
VCopyFile := VCopyFileEx( stPathFrom,
stPathTo,
Params,
cbeAll,
@MyCallBackProc );
END;
{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}
{────────────────────────────────────────────────────────────────────────────}
BEGIN
END.